home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / io.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-06-03  |  5.9 KB  |  223 lines
  1. 10  ' theorectically the worst case to discover baud/parity is six CRs
  2. 20  DEF FN TI! = CSNG( FIX(( VAL( MID$( TIME$ ,1,2)) * 60 * 60) + ( VAL( MID$( TIME$ ,4,2)) * 60) + ( VAL( MID$( TIME$ ,7,2)) * 1)))
  3. 30  A! = FRE("A")
  4. 40  ON ERROR GOTO 1720
  5. 50  TIME.OUT! = 3 * 60
  6. 60  BIT.8 = 0
  7. 70  OPEN "COM1:300,E,7,1,RS,CD1,DS" AS #3
  8. 80  GOTO 70
  9. 90  OPEN "COM1:300,E,7,1,RS,CD,DS" AS #3
  10. 100  MODTR = INP(&H3FE)
  11. 110  OUT &H3FE,&H0
  12. 120  OUT &H3FE,MODTR
  13. 130  PRINT #3,"ATZ"
  14. 140  FOR LOOP = 1 TO 3
  15. 150  PRINT #3, CHR$(13);
  16. 160  GOSUB 2040
  17. 170  NEXT
  18. 180  PRINT #3,"ATS2=128";
  19. 190  PRINT #3,"M0Q1S4=13S5=130S10=20S0=255S1?"
  20. 200  INPUT #3,X$
  21. 210  GOSUB 730
  22. 220  WHILE ( INP(&H3FE) AND &H40) = 0 ' wait for ring indicator bit to set TRUE
  23. 230  X$ = INKEY$
  24. 240  IF X$ = CHR$(27) THEN 250  ELSE 300 ' sysop escape into program
  25. 250  TI! = FN TI!
  26. 260  GOSUB 1920
  27. 270  PRT = 0
  28. 280  LOCAL = - 1
  29. 290  GOTO 2100
  30. 300  WEND
  31. 310  CLOSE #3
  32. 320  OPEN "COM1:300,E,7,1,RS,CD,DS" AS #3
  33. 330  PRINT #3,"ATQ1E1S0=0A"
  34. 340  CLOSE #3
  35. 350  OPEN "COM1:300,N,8,1,CD,DS,CS" AS #3
  36. 360  Q = &H180
  37. 370  QQ = &H60
  38. 380  QQQ = &H30 '****** test value for 2400 baud
  39. 390  IF PRT THEN LOCATE,,1
  40. 400  FOR JJ = 1 TO 600
  41. 410  SOUND 32767,1
  42. 420  IF INP(&H3FE) > 127 THEN 450
  43. 430  NEXT JJ
  44. 440  GOTO 1880
  45. 450  GOSUB 1960
  46. 460  GOSUB 2040
  47. 470  OUT &H3FB,&H3
  48. 480  BIT.8 = - 1
  49. 490  IF INP(&H3FE) < 128 THEN 1880  ELSE IF EOF(3) THEN 490
  50. 500  A = 0
  51. 510  A = ASC( INPUT$( LOC(3),3))
  52. 520  IF A = 13 THEN 600 ' got everything set because c/r is normal (No parity)
  53. 530  IF A = 141 THEN OUT &H3FB,&H1A : BIT.8 = 0 : GOTO 600 'same but Even parity ( ascii 13 + 128 high bit)
  54. 540  SWAP Q,QQ
  55. 550  SWAP QQ,QQQ ' ****** set swap for 2400 baud
  56. 560  GOSUB 1380
  57. 570  OUT &H3FB,&H3
  58. 580  BIT.8 = - 1
  59. 590  GOTO 490
  60. 600  GOSUB 730
  61. 610  IF Q = &H60 THEN BPS = - 1  ELSE BPS = 0
  62. 620  TI! = FN TI!
  63. 630  PRINT #3, CHR$(10)
  64. 640  PRINT #3,""
  65. 650  IF BIT.8 THEN PARM$ = "no parity, 8 data bits, 1 stop bit" ELSE PARM$ = "even parity, 7 data bits, 1 stop bit" ' ****** test string assignment for 2400 baud  <UNK! {FF00}> 6NEW<UNK! {0002}>IF Q=48 THEN BAUD$="2400 baud, " ELSE IF Q=96 THEN BAUD$ = "1200 baud, " ELSE BAUD$ = "300 baud, "
  66. 670  GOSUB 810
  67. 680  A$ = "Welcome to Terrapin Station! " + TIM$ + " " + DAT$
  68. 690  GOSUB 840
  69. 700  A$ = "Operating at " + BAUD$ + PARM$
  70. 710  GOSUB 840
  71. 720  GOTO 2100
  72. 730  TI$ = TIME$
  73. 740  MONTH$ = "JanFebMarAprMayJunJulAugSepOctNovDec"
  74. 750  DAT$ = MID$(MONTH$, VAL( LEFT$( DATE$ ,2)) * 3 - 2,3) + " "
  75. 760  DAT = INSTR( DATE$ ,"-")
  76. 770  DAT1 = INSTR(DAT + 1, DATE$ ,"-")
  77. 780  DAT$ = DAT$ + MID$( DATE$ ,DAT + 1,DAT1 - DAT - 1)
  78. 790  DAT = DAT1
  79. 800  DAT$ = DAT$ + " " + MID$( DATE$ ,DAT + 1, LEN( DATE$ ) - DAT)
  80. 810  TIM$ = TIME$
  81. 820  IF VAL( LEFT$(TIM$,2)) = 12 THEN MID$(TIM$,1,2) = RIGHT$( STR$( VAL( LEFT$( TIME$ ,2))),2) : TIM$ = LEFT$(TIM$,5) + " PM" : RETURN
  82. 830  IF VAL( LEFT$(TIM$,2)) > 11 THEN MID$(TIM$,1,2) = RIGHT$( STR$( VAL( LEFT$( TIME$ ,2))-12),2) : TIM$ = LEFT$(TIM$,5) + " PM" : RETURN ELSE TIM$=LEFT$(TIME$,5)+" AM":RETURN
  83. 840  REM *** output to modem ***
  84. 850  ' cr=1 no c/r; cr=2 two c/r; c/r=0 (default)
  85. 860  ' output is in a$
  86. 870  Y$ = INKEY$
  87. 880  IF LOCAL THEN 930
  88. 890  IF EOF(3) THEN GOSUB 2010 : GOTO 930
  89. 900  ON ERROR GOTO 1720
  90. 910  Y$ = INPUT$(1,#3)
  91. 920  IF Y$ = CHR$(19) THEN WHILE  EOF(3) : GOSUB 2010 : WEND  : GOTO 910
  92. 930  IF PRT THEN LOCATE ,,1 : PRINT A$;
  93. 940  IF LOCAL THEN PRINT A$; : GOTO 960
  94. 950  PRINT #3,A$;
  95. 960  IF CR = 1 THEN 1010
  96. 970  IF PRT AND NOT LOCAL THEN PRINT
  97. 980  IF LOCAL THEN PRINT  : GOTO 1000
  98. 990  PRINT #3,""
  99. 1000  IF CR = 2 THEN CR = 0 : GOTO 980
  100. 1010  Y$ = ""
  101. 1020  A$ = ""
  102. 1030  CR = 0
  103. 1040  RETURN
  104. 1050  REM *** input from modem ***
  105. 1060  ' a$ is output with no c/r
  106. 1070  ' b$ is input
  107. 1080  GOSUB 2010
  108. 1090  A! = FRE("A")
  109. 1100  TOUT! = FN TI!
  110. 1110  B$ = ""
  111. 1120  CR = 1
  112. 1130  GOSUB 840
  113. 1140  IF LOCAL THEN LINE INPUT "",B$ : RETURN
  114. 1150  WHILE EOF(3)
  115. 1160  GOSUB 2010
  116. 1170  MMM! = FN TI! - TOUT!
  117. 1180  IF MMM! > TIME.OUT! THEN 1880
  118. 1190  Y$ = INKEY$
  119. 1200  IF Y$ < > "" THEN 1250
  120. 1210  WEND
  121. 1220  IF INP(&H3FE) < 128 THEN 1880
  122. 1230  Y$ = INPUT$(1,#3)
  123. 1240  IF Y$ = CHR$(127) THEN 1330
  124. 1250  IF Y$ = CHR$(8) OR Y$ = CHR$(27) THEN 1330
  125. 1260  IF Y$ < " " AND Y$ < CHR$(13) THEN 1150
  126. 1270  IF PRT THEN PRINT Y$;
  127. 1280  PRINT #3,Y$;
  128. 1290  IF Y$ = CHR$(13) THEN Q = LEN(B$) : RETURN
  129. 1300  IF LEN(B$) = > 254 THEN A$ = "String too long!" : GOSUB 840 : GOTO 1080
  130. 1310  B$ = B$ + Y$
  131. 1320  GOTO 1150
  132. 1330  IF LEN(B$) = 0 THEN 1150
  133. 1340  B$ = LEFT$(B$, LEN(B$) - 1)
  134. 1350  IF PRT THEN PRINT CHR$(29) + CHR$(32) + CHR$(29);
  135. 1360  PRINT #3, CHR$(8) + CHR$(32) + CHR$(8);
  136. 1370  IF Y$ = CHR$(27) THEN 1330  ELSE 1150
  137. 1380  R1 = INP(&H3FB)
  138. 1390  K1 = R1 OR 128
  139. 1400  OUT &H3FB,K1 ' switch DLAB (Divisor Latch) from modem io to speed register
  140. 1410  IF Q = 384 THEN 1450
  141. 1420  IF Q = 96 THEN 1480
  142. 1430  IF Q = 48 THEN 1510 ' ****** test value for 2400 baud
  143. 1440  RETURN
  144. 1450  OUT &H3F8,&H80
  145. 1460  OUT &H3F9,&H1
  146. 1470  GOTO 1530
  147. 1480  OUT &H3F8,&H60
  148. 1490  OUT &H3F9,&H0
  149. 1500  GOTO 1530
  150. 1510  OUT &H3F8,&H30 ' ****** test statement for 2400 baud
  151. 1520  OUT &H3F9,&H0 ' ******  ^^^^
  152. 1530  OUT &H3FB,R1 ' reset DLAB to modem io
  153. 1540  RETURN
  154. 1550  GOTO 840
  155. 1560  HOUR = VAL( LEFT$(TI$,2))
  156. 1570  MIN = VAL( MID$(TI$,4,2))
  157. 1580  SEC = VAL( MID$(TI$,7,2))
  158. 1590  HH = VAL( LEFT$( TIME$ ,2))
  159. 1600  MM = VAL( MID$( TIME$ ,4,2))
  160. 1610  SS = VAL( MID$( TIME$ ,7,2))
  161. 1620  IF SEC < = SS THEN SSS = SS - SEC ELSE SSS = 60 - (SEC - SS) : MIN = MIN + 1
  162. 1630  IF MIN < = MM THEN MMM = MM - MIN ELSE MMM = 60 - (MIN - MM) : HOUR = HOUR + 1
  163. 1640  IF HOUR < = HH THEN HHH = HH - HOUR ELSE HHH = 24 - (HOUR - HH)
  164. 1650  GOSUB 810
  165. 1660  A$ = "It is now " + TIM$ + " " + DATE$
  166. 1670  GOSUB 840
  167. 1680  ACC# = HHH * 60 * 60 + MMM * 60 + SSS
  168. 1690  A$ = "You have been on for" + STR$(ACC#) + " seconds."
  169. 1700  GOSUB 840
  170. 1710  RETURN
  171. 1720  IF ERL = 70 AND ERR = 24 THEN RESUME 90
  172. 1730  IF ERL = 70 AND ERR = 55 THEN CLOSE #3 : RESUME 70
  173. 1740  IF ERL = 70 AND ERR = 57 THEN R1 = INP(&H3FD) : CLOSE 33 : RESUME 90
  174. 1750  IF ERL = 190 OR ERL = 200 THEN RESUME 190
  175. 1760  IF ( ERL = 510 AND NOT BIT.8) THEN OUT &H3FB,&H3 : RESUME 490
  176. 1770  IF ERL = 510 THEN RESUME 540
  177. 1780  IF ERL < 840 THEN RESUME 1880
  178. 1790  IF ERL = 910 AND ERR = 57 THEN R1 = INP(&H3FD) : RESUME 920
  179. 1800  IF ERL = 1230 OR ERL = 1970 THEN GOSUB 2040 : IF INP(&H3FE) < 127 THEN RESUME 1880
  180. 1810  IF ERL = 1230 THEN RESUME 1230
  181. 1820  IF ERL = 1960 THEN RESUME 1960
  182. 1830  IF 65535 = ERL THEN 1880
  183. 1840  IF ERR = 6 THEN 1880
  184. 1850  IF ERR = 5 THEN 1880
  185. 1860  IF ERR = 57 OR ERR = 24 OR ERR = 25 THEN GOSUB 2040 : R1 = INP(&H3FE) : IF R1 < 128 THEN RESUME 1880
  186. 1870  RESUME 1880
  187. 1880  CLOSE
  188. 1890  IF LOCAL THEN RETURN  ELSE CLOSE #3 : OUT &H3FC,&H4 : GOSUB 2060 : GOSUB 2060 : OUT &H3FC,&H0
  189. 1900  END
  190. 1910  RETURN
  191. 1920  PRINT #3,"ATM1Q1E1S0=0C0H1M0"
  192. 1930  GOSUB 2060
  193. 1940  CLOSE #3
  194. 1950  RETURN
  195. 1960  WHILE NOT EOF(3)
  196. 1970  DUMMY$ = INPUT$( LOC(3),3)
  197. 1980  WEND
  198. 1990  RETURN
  199. 2000  IF NOT BIT.8 THEN GOSUB 2060 : OUT &H3FB,3
  200. 2010  IF LOCAL THEN RETURN
  201. 2020  IF INP(&H3FE) < 128 THEN 1880
  202. 2030  RETURN
  203. 2040  DELAY! = FN TI! + 1
  204. 2050  GOTO 2070
  205. 2060  DELAY! = FN TI! + 3
  206. 2070  IF FN TI! < DELAY! THEN 2070  ELSE RETURN
  207. 2080  PRT = NOT PRT
  208. 2090  RETURN
  209. 2100  REM *** add program here ***
  210. 2110  ' examples of io
  211. 2120  A$ = "What is your first name ? "
  212. 2130  GOSUB 1080
  213. 2140  A$ = "Your name is " + B$ + "(y/n)"
  214. 2150  GOSUB 1080
  215. 2160  CR = 1
  216. 2170  A$ = "Checking user file..."
  217. 2180  GOSUB 870
  218. 2190  FOR LOOP = 1 TO 10000
  219. 2200  NEXT LOOP
  220. 2210  A$ = "Ok; name found"
  221. 2220  GOSUB 870
  222. 2230  ' end my example
  223.